;SIZE 11
;VSP 6
;TOPMAR 0
;BOTMAR 0
;LFTMAR 0
;SKIP 1
;SQUISH
;KSET FONTS;25FR1 KST,FONTS;20FG KST,FONTS;30VRB KST,FONTS;40VR KST,,
AI:GJS;NNTJ6 10.6











␈↓ ∧λ␈↓αMASSACHUSETTS INSTITUTE OF TECHNOLOGY␈↓
␈↓ ∧0␈↓αARTIFICIAL INTELLIGENCE LABORATORY␈↓

␈↓ αλWorking Paper No.␈↓ εx␈↓ 
(January 1976

␈↓ ¬A␈↓βSCHEME FLASH #1␈↓

␈↓ εhby

␈↓ ∧ Gerald Jay Sussman and Guy Lewis Steele Jr.





␈↓ αλAbstract:
␈↓ αhThis working paper contains an update to the SCHEME Reference Manual in
␈↓ αλAI Memo 349.  It also documents the "production version" of the SCHEME
␈↓ αλinterpreter (as opposed to the "tutorial version" of Memo 349), and describes
␈↓ αλthe programming techniques which enhance its speed.






␈↓ αλThis report describes research done at the Artificial Intelligence Laboratory
␈↓ αλof the Massachusetts Institute of Technology.  Support for the laboratory's
␈↓ αλartificial intelligence research is provided in part by the Advanced Research
␈↓ αλProjects Agency of the Department of Defense under Office of Naval Research
␈↓ αλcontract


␈↓ αλWorking papers are informal papers intended for internal use.



␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr1␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αλUpdates to the SCHEME Reference Manual


␈↓ αhBecause it is often necessary to type the sequence ↑G (SCHEME) at the
␈↓ αλSCHEME interpreter (e.g. whenever an error occurs!), we have implemented the
␈↓ αλsame control character that MACSYMA and NCOMPLR use to get back to the top
␈↓ αλlevel, namely ↑↑ (control-uparrow).  That is, typing ↑↑ at any time will
␈↓ αλcause a ↑G-type quit, then restart the SCHEME top level loop.

␈↓ αλA New AINT

␈↓ αλTEST
␈↓ αhThis primitive has been added to solve the famous "IT" problem
␈↓ αλassociated with COND clauses in LISP.  For example, how many times have you
␈↓ αλhad to write:

␈↓ αλ␈↓ αh␈↓↓(PROG (IT)␈↓
␈↓ β0␈↓↓(COND ...␈↓
␈↓ βx␈↓↓((SETQ IT (GET FOO 'QUUX))␈↓
␈↓ ∧∧␈↓↓(HACK IT))␈↓
␈↓ βx␈↓↓...␈↓
␈↓ βx␈↓↓((SETQ IT (ASSQ THE-OBJECT THE-LIST))␈↓
␈↓ ∧∧␈↓↓(STOMP IT)␈↓
␈↓ ∧∧␈↓↓(CLOBBER IT)␈↓
␈↓ ∧∧␈↓↓(TRANSMOGRIFY IT))␈↓
␈↓ βx␈↓↓... ))␈↓

␈↓ αλWe feel that this device is extremely unaesthetic for two reasons:
␈↓ αλ[1] The side-effects involved (the SETQ's on IT) are completely gratuitious
␈↓ αλ(in Hewitt's sense); there should be no need for them.
␈↓ αλ[2] The variable IT is forced to be scoped at the wrong level;  there is no
␈↓ αλlogical necessity to scope IT over the entire COND when its value in any
␈↓ αλinstance is used only within a single clause.
␈↓ αhThe TEST primitive is similar to IF; it differs only in that its second
␈↓ αλargument is a function of one argument instead of an expression.  If the
␈↓ αλpredicate expression (the first argument) evaluates to NIL, then the third
␈↓ αλargument is evaluated; but if the predicate evaluates to non-NIL, then the
␈↓ αλsecond argument is evaluated, and the result called as a function with the
␈↓ αλresult of the predicate as its argument.  For example:

␈↓ αλ␈↓ αh␈↓↓(TEST (ASSQ THE-OBJECT THE-LIST)␈↓
␈↓ β0␈↓↓(LAMBDA (IT)␈↓
␈↓ ∧⊂␈↓↓(BLOCK (STOMP IT)␈↓
␈↓ ∧d␈↓↓(CLOBBER IT)␈↓
␈↓ ∧d␈↓↓(TRANSMOGRIFY IT)))␈↓
␈↓ β0␈↓↓THE-ALTERNATIVE)␈↓


␈↓ αhIt is worth noting that the TEST primitive could easily be implemented
␈↓ αλas an AMACRO in terms of IF -- and vice versa.  For example, the following


␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr2␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αλpieces of code are equivalent:

␈↓ αλ␈↓ αh␈↓↓(IF FOO BAR BLETCH)␈↓
␈↓ αh␈↓↓(TEST FOO (LAMBDA (IGNORE) BAR) BLETCH)␈↓

␈↓ αλas long as BAR doesn't use the variable IGNORE.  Similarly equivalent are:

␈↓ αλ␈↓ αh␈↓↓(TEST FOO BAR BLETCH)␈↓
␈↓ αh␈↓↓((LAMBDA (IT) (IF IT (BAR IT) BLETCH)) FOO)␈↓

␈↓ αλexcept that, again, the variable scoping is not what is desired.  Because we
␈↓ αλaren't sure which is the more desirable for a primitive conditional, we have
␈↓ αλimplemented both as primitives so that they may be played with.


␈↓ αλNew AMACROs

␈↓ αhSeveral new AMACROs have been implemented.  One large class of them are
␈↓ αλknown as AFSUBRs; they are the "convenience" FSUBRs of LISP (convenient
␈↓ αλbecause one needn't type "'"), having none of the theoretical significance
␈↓ αλthat COND and QUOTE do.  The AFSUBRs are in fact MacLISP FSUBRs, and are
␈↓ αλexecuted by MacLISP; the AMACRO feature is merely used to interface these
␈↓ αλFSUBRs to SCHEME.  Currently defined AFSUBRs include:

␈↓ αhUREAD     GRINDEF     FASLOAD     EDIT
␈↓ αhSTATUS    SSTATUS     DEFUN       SETQ

␈↓ αλOne point to beware concerning SETQ: the second argument is evaluated by LISP
␈↓ αλand not by SCHEME!  To set a global variable to a SCHEME value, say (ASET' FOO
␈↓ αλ(BAR)), not (SETQ FOO (BAR)).
␈↓ αhTwo other AMACROs of interest have been implemented:  AMAPCAR and
␈↓ αλAMAPLIST.  These are like the LISP functions MAPCAR and MAPLIST, but expect
␈↓ αλSCHEME functions as their first arguments.


␈↓ αλReader Macro Characters

␈↓ αhA convenience feature ripped off from [a] CONNIVER [b] MUDDLE [c]
␈↓ αλCONVERT [d] SNOBOL? [e] PLASMA?? (choose any or all) is the "unquoting quote"
␈↓ αλfeature.  This is available to SCHEME users as a set of three LISP reader
␈↓ αλmacro characters.  (They are included primarily because they make it easier to
␈↓ αλimplement AMACROs.) The character " (double quote) quotes the following s-
␈↓ αλexpression, but in a special way:  if within the expression the characters ,
␈↓ αλ(comma) and @ (atsign) are used, they cause the following expressions to be
␈↓ αλevaluated and substituted in at run time.  More exactly, " constructs a piece
␈↓ αλof code which will duplicate the expression with the indicated substitutions
␈↓ αλusing the minimal number of conses.  An occurrence of ,FOO indicates that the
␈↓ αλvalue of FOO is to be substituted as an expression; an occurrence of @FOO
␈↓ αλindicates that the value of FOO is to be substituted as a list fragment.  For
␈↓ αλexample, writing


␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr3␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αλ␈↓ αh␈↓↓"(LAMBDA (@VARS C) (C ,(CAR VARS) (HACK @(CDR VARS) 'FOO)))␈↓

␈↓ αλis an abbreviation for the code

␈↓ αλ␈↓ αh␈↓↓(CONS 'LAMBDA␈↓
␈↓ β0␈↓↓(CONS (APPEND VARS '(C))␈↓
␈↓ βx␈↓↓(CONS (CONS 'C␈↓
␈↓ ¬λ␈↓↓(CONS (CAR VARS)␈↓
␈↓ ¬P␈↓↓(CONS (CONS 'HACK␈↓
␈↓ ε`␈↓↓(APPEND (CDR VARS)␈↓
␈↓ π@␈↓↓'('FOO)))␈↓
␈↓ ε_␈↓↓'NIL)))␈↓
␈↓ ∧@␈↓↓'NIL)))␈↓

␈↓ αλwhich is both easier to read and easier to write.


␈↓ αλEnd of Updates to the SCHEME Reference Manual



␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr4␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αλThe "Production Version" of SCHEME


␈↓ αhThe implementation of the SCHEME interpreter presented in AI Memo 349
␈↓ αλwas written with clarity in mind rather than blinding speed.  Here we present
␈↓ αλa more efficient version, which is somewhat more obscure in its
␈↓ αλimplementation, but which interprets SCHEME code approximately twice as fast.
␈↓ αλFor convenience, we will refer to the interpreter of Memo 349 as SCHEME, and
␈↓ αλto the one presented here as SCHFST.  We assume that the reader is already
␈↓ αλfamiliar with the implementation of SCHEME.
␈↓ αhWhen SCHEME has to evaluate an argument subexpression of a given
␈↓ αλexpression, it has to save up all the registers such as **ENV** in a frame
␈↓ αλbefore evaluating the subexpression;  this is true even if the subexpression
␈↓ αλis something which can be evaluated trivially, like a number.  SCHFST was
␈↓ αλdesigned specifically to avoid superfluous frame consing at this level by
␈↓ αλdeferring the consing of a frame until such a time as it becomes absolutely
␈↓ αλnecessary.  (A similar technique was used in the CONNIVER interpreter.) The
␈↓ αλregisters **EXP**, **ENV**, and so on are in SCHFST exactly as they were in
␈↓ αλSCHEME; in addition, the local variables EXP1, ENV1, and RETAG are used in
␈↓ αλvarious places to hold parts of a potential new frame while it is being
␈↓ αλdetermined whether the current one needs to be pushed onto the **CLINK**
␈↓ αλstack.  If, for example, EXP1 is found to contain a number (or, more
␈↓ αλimportantly, a variable), then the potential new frame is flushed immediately,
␈↓ αλand evaluation may proceed by setting **VAL** to EXP1 and **PC** to RETAG; the
␈↓ αλold frame need never be saved and restored.  If, on the other hand, EXP1
␈↓ αλcontains a combination, the current frame registers are saved as a **CLINK**
␈↓ αλ(with RETAG as the return PC), and **EXP** and **ENV** are set to EXP1 and
␈↓ αλENV1 respectively;  the other registers (such as **EVLIS**) are appropriately
␈↓ αλinitialized for evaluating the combination.
␈↓ αhWe might speculate that this technique could be iterated to two or more
␈↓ αλlevels of temporary frame registers to gain even more speed (because of
␈↓ αλavoided saving and restoring of frames); in fact, two levels would allow pure
␈↓ αλcontinuation-passing style SCHEME programs to run with no consing of CLINKs at
␈↓ αλall (␈↓¬e␈↓'β␈↓'α: we really mean ␈↓&no␈↓'β␈↓'α consing, and not just no ␈↓&net␈↓'β␈↓'α consing, which is
␈↓ αλtrue even of the SCHEME implementation).  Unfortunately, several effects
␈↓ αλinterfere with the prospect of winning infinitely.  As more register levels
␈↓ αλare added, less is gained because there are fewer nodes higher up in the
␈↓ αλcomputation tree.  Furthermore, a point is eventually reached where it is
␈↓ αλcheaper to save up a frame than to shuffle all the temporary registers around.
␈↓ αλFinally, the fact that the MacLISP compiler cannot efficiently compile
␈↓ αλfunctions of more than five arguments implies that special variables must be
␈↓ αλused for the temporary registers rather than the local variables used in
␈↓ αλSCHFST; hence use of more than one set of temporary registers might imply
␈↓ αλslightly slower access to the registers of immediate interest (but then again
␈↓ αλthis effect might be offset by not having to push and pop these local
␈↓ αλvariables; this is an area for further experimentation).



␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr5␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αhThe declarations and VERSION macros are approximately as they were in
␈↓ αλSCHEME.

␈↓ αλ␈↓↓(DECLARE (MAPEX T)␈↓ ∧(␈↓ ¬λ;compile mapping functions as do loops␈↓
␈↓ αt␈↓↓(SPECIAL **EXP** **ENV** **UNEVLIS** **EVLIS** **PC**␈↓
␈↓ ∧@␈↓↓**CLINK** **VAL** **TEM**␈↓
␈↓ β`␈↓↓**QUEUE** **TICK** **QUANTUM** **PROCESS** **PROCNUM**␈↓
␈↓ β`␈↓↓VERSION LISPVERSION))␈↓

␈↓ αλ␈↓↓(DEFUN VERSION MACRO (X)␈↓
␈↓ α\␈↓↓(COND (COMPILER-STATE (LIST 'QUOTE (STATUS UREAD)))␈↓
␈↓ β$␈↓↓(T (RPLACA X 'QUOTE)␈↓
␈↓ βH␈↓↓(RPLACD X (LIST VERSION))␈↓
␈↓ βH␈↓↓(LIST 'QUOTE VERSION))))␈↓

␈↓ αλ␈↓↓(DECLARE (READ))␈↓

␈↓ αλ␈↓↓(SETQ VERSION ((LAMBDA (COMPILER-STATE) (VERSION)) T))␈↓

␈↓ αhBecause AINTs are really extensions of the evaluator, we will need a
␈↓ αλFASTCALL3 analogous to FASTCALL in order to call AINTs with EXP1, ENV1, and
␈↓ αλRETAG as arguments.

␈↓ αλ␈↓↓(DEFUN FASTCALL (ATSYM)␈↓
␈↓ α\␈↓↓(COND ((EQ (CAR (CDR ATSYM)) 'SUBR)␈↓
␈↓ β0␈↓↓(SUBRCALL NIL (CADR (CDR ATSYM))))␈↓
␈↓ β$␈↓↓(T ((LAMBDA (SUBR)␈↓
␈↓ ∧4␈↓↓(COND (SUBR (REMPROP ATSYM 'SUBR)␈↓
␈↓ ¬D␈↓↓(PUTPROP ATSYM␈↓
␈↓ ε0␈↓↓SUBR␈↓
␈↓ ε0␈↓↓'SUBR)␈↓
␈↓ ¬D␈↓↓(SUBRCALL NIL SUBR))␈↓
␈↓ ∧|␈↓↓(T (APPLY ATSYM NIL))))␈↓
␈↓ βT␈↓↓(GET ATSYM 'SUBR)))))␈↓

␈↓ αλ␈↓↓(DEFUN FASTCALL3 (ATSYM ARG1 ARG2 ARG3)␈↓
␈↓ α\␈↓↓(COND ((EQ (CAR (CDR ATSYM)) 'SUBR)␈↓
␈↓ β0␈↓↓(SUBRCALL NIL (CADR (CDR ATSYM)) ARG1 ARG2 ARG3))␈↓
␈↓ β$␈↓↓(T ((LAMBDA (SUBR)␈↓
␈↓ ∧4␈↓↓(COND (SUBR (REMPROP ATSYM 'SUBR)␈↓
␈↓ ¬D␈↓↓(PUTPROP ATSYM␈↓
␈↓ ε0␈↓↓SUBR␈↓
␈↓ ε0␈↓↓'SUBR)␈↓
␈↓ ¬D␈↓↓(SUBRCALL NIL SUBR ARG1 ARG2 ARG3))␈↓
␈↓ ∧|␈↓↓(T (FUNCALL ATSYM ARG1 ARG2 ARG3))))␈↓
␈↓ βT␈↓↓(GET ATSYM 'SUBR)))))␈↓



␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr6␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αhThe top level functions of the interpreter and the scheduler are the
␈↓ αλsame here as in SCHEME.

␈↓ αλ␈↓↓(DEFUN SCHEME ()␈↓
␈↓ α\␈↓↓(SETQ VERSION (VERSION)  LISPVERSION (STATUS LISPVERSION))␈↓
␈↓ α\␈↓↓(TERPRI)␈↓
␈↓ α\␈↓↓(PRINC '|This is SCHEME |)␈↓
␈↓ α\␈↓↓(PRINC VERSION)␈↓
␈↓ α\␈↓↓(PRINC '| running in LISP |)␈↓
␈↓ α\␈↓↓(PRINC LISPVERSION)␈↓
␈↓ α\␈↓↓(SETQ **ENV** NIL  **QUEUE** NIL␈↓
␈↓ β$␈↓↓**PROCESS** (CREATE!PROCESS '(**TOP** '|SCHEME -- Toplevel| '|==> |)))␈↓
␈↓ α\␈↓↓(SWAPINPROCESS)␈↓
␈↓ α\␈↓↓(ALARMCLOCK 'RUNTIME **QUANTUM**)␈↓
␈↓ α\␈↓↓(MLOOP))␈↓

␈↓ αλ␈↓↓(SETQ **TOP**␈↓
␈↓ αP␈↓↓'(LAMBDA (**MESSAGE** **PROMPT**)␈↓
␈↓ β<␈↓↓(LABELS ((**TOP1**␈↓
␈↓ ∧@␈↓↓(LAMBDA (**IGNORE1** **IGNORE2** **IGNORE3**)␈↓
␈↓ ∧d␈↓↓(**TOP1** (TERPRI) (PRINC **PROMPT**)␈↓
␈↓ ¬\␈↓↓(PRINT (SET '* (EVALUATE (READ))))))))␈↓
␈↓ βx␈↓↓(**TOP1** (TERPRI) (PRINC **MESSAGE**) NIL))))␈↓

␈↓ αλ␈↓↓(DEFUN MLOOP ()␈↓
␈↓ α\␈↓↓(DO ((**TICK** NIL))  (NIL)␈↓
␈↓ β␈↓↓(AND **TICK** (ALLOW) (SCHEDULE))␈↓
␈↓ β␈↓↓(FASTCALL **PC**)))␈↓

␈↓ αλ␈↓↓(DEFUN ALLOW ()␈↓
␈↓ α ␈↓↓((LAMBDA (VCELL)␈↓
␈↓ α\␈↓↓(COND (VCELL (CADR VCELL))␈↓
␈↓ β$␈↓↓(T T)))␈↓
␈↓ α,␈↓↓(ASSQ '*ALLOW* **ENV**)))␈↓

␈↓ αλ␈↓↓(DEFUN SCHEDULE ()␈↓
␈↓ α\␈↓↓(COND (**QUEUE**␈↓
␈↓ β0␈↓↓(SWAPOUTPROCESS)␈↓
␈↓ β0␈↓↓(NCONC **QUEUE** (LIST **PROCESS**))␈↓
␈↓ β0␈↓↓(SETQ **PROCESS** (CAR **QUEUE**)␈↓
␈↓ βx␈↓↓**QUEUE** (CDR **QUEUE**))␈↓
␈↓ β0␈↓↓(SWAPINPROCESS)))␈↓
␈↓ α\␈↓↓(SETQ **TICK** NIL)␈↓
␈↓ α\␈↓↓(ALARMCLOCK 'RUNTIME **QUANTUM**))␈↓

␈↓ αλ␈↓↓(DEFUN SWAPOUTPROCESS ()␈↓
␈↓ α\␈↓↓((LAMBDA (**CLINK**)␈↓
␈↓ βH␈↓↓(PUTPROP **PROCESS** (SAVEUP **PC**) 'CLINK)␈↓
␈↓ βH␈↓↓(PUTPROP **PROCESS** **VAL** 'VAL))␈↓
␈↓ αh␈↓↓**CLINK**))␈↓


␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr7␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αλ␈↓↓(DEFUN SWAPINPROCESS ()␈↓
␈↓ α\␈↓↓(SETQ **CLINK** (GET **PROCESS** 'CLINK)␈↓
␈↓ β$␈↓↓**VAL** (GET **PROCESS** 'VAL))␈↓
␈↓ α\␈↓↓(RESTORE))␈↓

␈↓ αλ␈↓↓(DEFUN SETTICK (X) (SETQ **TICK** T)) (SETQ **QUANTUM** 1000000. ALARMCLOCK 'SETTICK)␈↓



␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr8␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αhHere we have the first non-trivial difference between SCHFST and SCHEME.
␈↓ αλInstead of the central function AEVAL (which was always called with no
␈↓ αλarguments by having **PC** set to 'AEVAL), we have the function DISPATCH of
␈↓ αλthree arguments EXP1, ENV1, and RETAG, which represent the potential new
␈↓ αλframe.  It should be noted that calling DISPATCH directly does not violate our
␈↓ αλprinciple of avoiding the use of host language control structure, since
␈↓ αλDISPATCH itself is not recursive, but always exits either by setting **PC** or
␈↓ αλby invoking an AINT in an "iterative" fashion, i.e. via tail-recursion, and
␈↓ αλthe AINTs in turn call DISPATCH back only in iterative fashion.  (The MacLISP
␈↓ αλcompiler understands tail-recursion in the case that no bindings of SPECIAL
␈↓ αλvariables are involved; that is, the sequence
␈↓ αhPUSHJ P,FOO␈↓ ∧(transforms into     JRST FOO
␈↓ αhPOPJ P,
␈↓ αλexcept in screw cases; but in such cases we may properly consider the MacLISP
␈↓ αλcompiler to be doing the "wrong" thing for us.  Even if the compiler should
␈↓ αλscrew us, however, we are saved by the fact that all potentially infinite
␈↓ αλloops must eventually be processed by EVLIS1, which can be entered only from
␈↓ αλMLOOP by setting **PC**.  The worst that can happen is that AINTs can cause
␈↓ αλLISP stack to be pushed proportional in size to the lexical depth of nesting
␈↓ αλof the AINT constructs.)

␈↓ αλ␈↓↓(DEFUN DISPATCH (EXP1 ENV1 RETAG)␈↓
␈↓ α,␈↓↓(PROG (TEM1)␈↓
␈↓ α8␈↓↓LP (COND ((ATOM EXP1)␈↓
␈↓ β0␈↓↓(COND ((NUMBERP EXP1)␈↓
␈↓ ∧∧␈↓↓(SETQ **VAL** EXP1  **PC** RETAG))␈↓
␈↓ βx␈↓↓((PRIMOP EXP1)␈↓
␈↓ ∧∧␈↓↓(SETQ **VAL** EXP1  **PC** RETAG))␈↓
␈↓ βx␈↓↓((SETQ TEM1 (ASSQ EXP1 ENV1))␈↓
␈↓ ∧∧␈↓↓(SETQ **VAL** (CADR TEM1)  **PC** RETAG))␈↓
␈↓ βx␈↓↓(T (SETQ **VAL** (SYMEVAL EXP1)  **PC** RETAG))))␈↓
␈↓ β$␈↓↓((EQ (CAR EXP1) 'LAMBDA)␈↓
␈↓ β0␈↓↓(SETQ **VAL** (LIST 'BETA EXP1 ENV1)  **PC** RETAG))␈↓
␈↓ β$␈↓↓((ATOM (CAR EXP1))␈↓
␈↓ β0␈↓↓(COND ((SETQ TEM1 (GET (CAR EXP1) 'AINT))␈↓
␈↓ ∧∧␈↓↓(FASTCALL3 TEM1 EXP1 ENV1 RETAG))␈↓
␈↓ βx␈↓↓((SETQ TEM1 (GET (CAR EXP1) 'AMACRO))␈↓
␈↓ ∧∧␈↓↓(SETQ EXP1 (FUNCALL TEM1 EXP1))␈↓
␈↓ ∧∧␈↓↓(GO LP))␈↓
␈↓ βx␈↓↓(T (SAVEUP RETAG)␈↓
␈↓ ∧≤␈↓↓(SETQ **EVLIS** (LIST (COND ((PRIMOP (CAR EXP1)) (CAR EXP1))␈↓
␈↓ ε<␈↓↓((SETQ TEM1 (ASSQ (CAR EXP1) ENV1))␈↓
␈↓ εH␈↓↓(CADR TEM1))␈↓
␈↓ ε<␈↓↓(T (SYMEVAL (CAR EXP1)))))␈↓
␈↓ ∧d␈↓↓**UNEVLIS** (CDR EXP1)␈↓
␈↓ ∧d␈↓↓**EXP** EXP1  **ENV** ENV1␈↓
␈↓ ∧d␈↓↓**PC** 'EVLIS1))))␈↓
␈↓ β$␈↓↓((EQ (CAAR EXP1) 'LAMBDA)␈↓
␈↓ β0␈↓↓(SAVEUP RETAG)␈↓
␈↓ β0␈↓↓(SETQ **EVLIS** (LIST (CAR EXP1))  **UNEVLIS** (CDR EXP1)␈↓


␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εr9␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ βx␈↓↓**EXP** EXP1  **ENV** ENV1␈↓
␈↓ βx␈↓↓**PC** 'EVLIS1))␈↓
␈↓ β$␈↓↓(T (SAVEUP RETAG)␈↓
␈↓ βH␈↓↓(SETQ **EXP** EXP1  **ENV** ENV1␈↓
␈↓ ∧⊂␈↓↓**UNEVLIS** EXP1  **EVLIS** NIL␈↓
␈↓ ∧⊂␈↓↓**PC** 'EVLIS1)))))␈↓



␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εl10␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αhEVLIS1 is to SCHFST as EVLIS was to SCHEME, and similarly EVLIS2 and
␈↓ αλEVLIS1 (thanks to random typos -- we apologize profusely for the renaming, but
␈↓ αλrefuse to change it now (while you're at it, complain to Greenblatt about
␈↓ αλIBASE and OBASE)).  The intention is the same in either case: to evaluate
␈↓ αλarguments and eventually apply the function to them.

␈↓ αλ␈↓↓(DEFUN EVLIS1 ()␈↓
␈↓ α\␈↓↓(COND ((NULL **UNEVLIS**)␈↓
␈↓ β0␈↓↓(PROG (EV1 ENV1)␈↓
␈↓ βx␈↓↓(SETQ EV1 (REVERSE **EVLIS**))␈↓
␈↓ βx␈↓↓(COND ((ATOM (CAR EV1))␈↓
␈↓ ∧L␈↓↓(RESTORE)␈↓
␈↓ ∧L␈↓↓(SETQ **VAL** (APPLY (CAR EV1) (CDR EV1))))␈↓
␈↓ ∧@␈↓↓((EQ (CAAR EV1) 'LAMBDA)␈↓
␈↓ ∧L␈↓↓(SETQ ENV1 **ENV**)␈↓
␈↓ ∧L␈↓↓(RESTORE)␈↓
␈↓ ∧L␈↓↓(DISPATCH (CADDAR EV1)␈↓
␈↓ ¬D␈↓↓(PAIRLIS (CADAR EV1) (CDR EV1) ENV1)␈↓
␈↓ ¬D␈↓↓**PC**))␈↓
␈↓ ∧@␈↓↓((EQ (CAAR EV1) 'BETA)␈↓
␈↓ ∧L␈↓↓(RESTORE)␈↓
␈↓ ∧L␈↓↓(DISPATCH (CADDR (CADAR EV1))␈↓
␈↓ ¬D␈↓↓(PAIRLIS (CADR (CADAR EV1))␈↓
␈↓ ε0␈↓↓(CDR EV1)␈↓
␈↓ ε0␈↓↓(CADDAR EV1))␈↓
␈↓ ¬D␈↓↓**PC**))␈↓
␈↓ ∧@␈↓↓((EQ (CAAR EV1) 'DELTA)␈↓
␈↓ ∧L␈↓↓(SETQ **CLINK** (CADAR EV1))␈↓
␈↓ ∧L␈↓↓(RESTORE))␈↓
␈↓ ∧@␈↓↓(T (ERROR '|BAD FUNCTION - EVARGLIST| **EXP** 'FAIL-ACT)))))␈↓
␈↓ β$␈↓↓(T (DISPATCH (CAR **UNEVLIS**) **ENV** 'EVLIS2))))␈↓

␈↓ αλ␈↓↓(DEFUN EVLIS2 ()␈↓
␈↓ α∀␈↓↓(SETQ **EVLIS** (CONS **VAL** **EVLIS**)  **UNEVLIS** (CDR **UNEVLIS**)  **PC** 'EVLIS1))␈↓



␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εl11␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αλ;;; ##### we left off here ###### ******** %%%%%%% &&&&&&&& $$$$$$$ !!!!!!!!
␈↓ αλ(DEFPROP EVALUATE AEVAL AINT) (DEFUN AEVAL (EXP1 ENV1 RETAG)
␈↓ α\(SAVEUP RETAG) (SETQ **ENV** ENV1)
␈↓ α\(DISPATCH (CADR EXP1) ENV1 'AEVAL1)) (DEFUN AEVAL1 ()
␈↓ α\(SETQ **TEM** **ENV**) (RESTORE)
␈↓ α\(DISPATCH **VAL** **TEM** **PC**)) (DEFPROP IF AIF AINT) (DEFUN AIF
␈↓ αλ(EXP1 ENV1 RETAG)
␈↓ α\(SAVEUP RETAG)
␈↓ α\(SETQ **EXP** EXP1  **ENV** ENV1)
␈↓ α\(DISPATCH (CADR EXP1) ENV1 'IF1)) (DEFUN IF1 ()
␈↓ α,(PROG (EXP1 ENV1)
␈↓ α\(SETQ EXP1 **EXP**  ENV1 **ENV**)
␈↓ α\(RESTORE)
␈↓ α\(COND (**VAL** (DISPATCH (CADDR EXP1) ENV1 **PC**))
␈↓ β$(T (DISPATCH (CADDDR EXP1) ENV1 **PC**))))) (DEFPROP TEST ATEST
␈↓ αλAINT) (DEFUN ATEST (EXP1 ENV1 RETAG)
␈↓ α\(SAVEUP RETAG)
␈↓ α\(SETQ **EXP** EXP1  **ENV** ENV1)
␈↓ α\(DISPATCH (CADR EXP1) ENV1 'TEST1)) (DEFUN TEST1 ()
␈↓ α\(COND (**VAL**
␈↓ β0(SETQ **EVLIS** **VAL**)
␈↓ β0(DISPATCH (CADDR **EXP**) **ENV** 'TEST2))
␈↓ β$(T ((LAMBDA (EXP1 ENV1)
␈↓ ∧4(RESTORE)
␈↓ ∧4(DISPATCH (CADDDR EXP1) ENV1 **PC**))
␈↓ βT**EXP** **ENV**)))) (DEFUN TEST2 ()
␈↓ α\(SETQ **EVLIS** (LIST **EVLIS** **VAL**))
␈↓ α\(SETQ **UNEVLIS** NIL)
␈↓ α\(EVLIS1)) (DEFPROP QUOTE AQUOTE AINT) (DEFUN AQUOTE (EXP1 ENV1 RETAG)
␈↓ α\(SETQ **VAL** (CADR EXP1)  **PC** RETAG)) (DEFPROP LABELS ALABELS AINT)
␈↓ αλ(DEFUN ALABELS (EXP1 ENV1 RETAG)
␈↓ α\(SETQ **TEM** (MAPCAR '(LAMBDA (DEF)
␈↓ ¬ (LIST (CAR DEF)
␈↓ ¬h(LIST 'BETA (CADR DEF) NIL)))
␈↓ ∧4(CADR EXP1)))
␈↓ α\(MAPC '(LAMBDA (VC) (RPLACA (CDDADR VC) **TEM**)) **TEM**)
␈↓ α\(DISPATCH (CADDR EXP1) (NCONC **TEM** ENV1) RETAG)) ;SIDE EFFECTS.
␈↓ αλ(DEFPROP DEFINE ADEFINE AINT) (DEFUN ADEFINE (EXP1 ENV1 RETAG)
␈↓ α\(SET (CADR EXP1) (LIST 'BETA  (CADDR EXP1) NIL))
␈↓ α\(SETQ **VAL** (CADR EXP1)  **PC** RETAG)) (DEFPROP ASET AASET AINT)
␈↓ αλ(DEFUN AASET (EXP1 ENV1 RETAG)
␈↓ α\(SAVEUP RETAG)
␈↓ α\(SETQ **EXP** EXP1  **ENV** ENV1)
␈↓ α\(DISPATCH (CADR EXP1) ENV1 'AASET1)) (DEFUN AASET1 ()
␈↓ α\(SETQ **EVLIS** **VAL**)
␈↓ α\(DISPATCH (CADDR **EXP**) **ENV** 'AASET2)) (DEFUN AASET2 ()
␈↓ α\(SETQ **TEM** (ASSQ **EVLIS** **ENV**))
␈↓ α\(COND (**TEM** (RPLACA (CDR **TEM**) **VAL**))
␈↓ β$(T (SET **EVLIS** **VAL**)))
␈↓ α\(RESTORE)) ;HAIRY CONTROL STRUCTURE.  (SETQ **PROCNUM** 0) (DEFUN


␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εl12␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αλGENPROCNAME ()
␈↓ α\((LAMBDA (BASE *NOPOINT)
␈↓ βH(IMPLODE (APPEND '(P R O C E S S)
␈↓ ¬ (EXPLODEN (SETQ **PROCNUM** (1+ **PROCNUM**))))))
␈↓ αh10. T)) (DEFUN CREATE!PROCESS (EXP1)
␈↓ α\((LAMBDA (**PROCESS** **EXP** **ENV**
␈↓ βT**UNEVLIS** **EVLIS** **PC** **CLINK** **VAL**)
␈↓ βH(DISPATCH EXP1 **ENV** 'TERMINATE)
␈↓ βH(SWAPOUTPROCESS)
␈↓ βH**PROCESS**)
␈↓ αh(GENPROCNAME) NIL **ENV** NIL NIL NIL NIL NIL)) (DEFUN START!PROCESS (P)
␈↓ α\(COND ((OR (NOT (ATOM P)) (NOT (GET P 'CLINK)))
␈↓ β0(ERROR '|BAD PROCESS - START!PROCESS| P 'FAIL-ACT)))
␈↓ α\(OR (EQ P **PROCESS**) (MEMQ P **QUEUE**)
␈↓ β(SETQ **QUEUE** (NCONC **QUEUE** (LIST P))))
␈↓ α\P) (DEFUN STOP!PROCESS (P)
␈↓ α\(COND ((MEMQ P **QUEUE**)
␈↓ β0(SETQ **QUEUE** (DELETE P **QUEUE**)))
␈↓ β$((EQ P **PROCESS**) (TERMINATE)))
␈↓ α\P) (DEFUN TERMINATE ()
␈↓ α\(SWAPOUTPROCESS)
␈↓ α\(COND ((NULL **QUEUE**)
␈↓ β0(SETQ **ENV** NIL)
␈↓ β0(SETQ **PROCESS**
␈↓ βx(CREATE!PROCESS '(**TOP** '|SCHEME -- QUEUEOUT| '|==> |))))
␈↓ β$(T (SETQ **PROCESS** (CAR **QUEUE**)
␈↓ ∧⊂**QUEUE** (CDR **QUEUE**))))
␈↓ α\(SWAPINPROCESS)
␈↓ α\'TERMINATE-VALUE) (DEFPROP EVALUATE!UNINTERRUPTIBLY EVUN AINT) (DEFUN
␈↓ αλEVUN (EXP1 ENV1 RETAG)
␈↓ α\(DISPATCH (CADR EXP1) (CONS (LIST '*ALLOW* NIL) ENV1) RETAG)) (DEFPROP
␈↓ αλCATCH ACATCH AINT) (DEFUN ACATCH (EXP1 ENV1 RETAG)
␈↓ α\(DISPATCH (CADDR EXP1)
␈↓ βT(CONS (LIST (CADR EXP1)
␈↓ ∧d(LIST 'DELTA
␈↓ ¬,((LAMBDA (**CLINK**) (SAVEUP RETAG))
␈↓ ¬8**CLINK**)))
␈↓ ∧≤ENV1)
␈↓ βTRETAG)) ;INTERPRETER DATA STRUCTURES.  (DEFUN PAIRLIS (X Y Z)
␈↓ α\(DO ((I X (CDR I))
␈↓ β_(J Y (CDR J))
␈↓ β_(L Z (CONS (LIST (CAR I) (CAR J)) L)))
␈↓ β((AND (NULL I) (NULL J)) L)
␈↓ β(AND (OR (NULL I) (NULL J))
␈↓ β<(ERROR '|WRONG NUMBER OF ARGUMENTS - PAIRLIS|
␈↓ ∧⊂**EXP**
␈↓ ∧⊂'WRNG-NO-ARGS)))) (DEFUN PRIMOP (X) (GETL X '(SUBR EXPR
␈↓ αλLSUBR))) (DEFUN SAVEUP (RETAG)
␈↓ α\(SETQ **CLINK**
␈↓ β$(CONS **EXP**


␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εl13␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ βl(CONS **ENV**
␈↓ ∧4(CONS **UNEVLIS**
␈↓ ∧|(CONS **EVLIS**
␈↓ ¬D(CONS RETAG **CLINK**))))))) (DEFUN RESTORE ()
␈↓ α (PROG (LTEM)
␈↓ α\(SETQ LTEM (OR **CLINK**
␈↓ ∧∧(ERROR '|PROCESS RAN OUT - RESTORE|
␈↓ ∧d**EXP**
␈↓ ∧d'FAIL-ACT))
␈↓ β$**EXP** (CAR LTEM)
␈↓ β0LTEM (CDR LTEM)
␈↓ β$**ENV** (CAR LTEM)
␈↓ β0LTEM (CDR LTEM)
␈↓ β$**UNEVLIS** (CAR LTEM)
␈↓ β0LTEM (CDR LTEM)
␈↓ β$**EVLIS** (CAR LTEM)
␈↓ β0LTEM (CDR LTEM)
␈↓ β$**PC** (CAR LTEM)
␈↓ β$**CLINK** (CDR LTEM)))) (DEFUN SCHEMESTART NARGS
␈↓ α\(SSTATUS TOPLEVEL '(SCHEMESTART1))
␈↓ α\(NOINTERRUPT NIL)
␈↓ α\(↑G)) (DEFUN SCHEMESTART1 ()
␈↓ α\(SSTATUS TOPLEVEL NIL)
␈↓ α\(CURSORPOS 'C)
␈↓ α\(SCHEME)) (COND ((STATUS FEATURE NEWIO)
␈↓ α\(SSTATUS TTYINT '/≡ 'SCHEMESTART))
␈↓ αP(T (SSTATUS INTERRUPT 16. 'SCHEMESTART))) (DECLARE (READ)) (SSTATUS MACRO
␈↓ αλ/% '(LAMBDA ()())) (DECLARE (SSTATUS MACRO /% '(LAMBDA () ((LAMBDA (/%) (EVAL
␈↓ αλ/%) /%) (READ)))) ) (DECLARE (MAPEX T) (MACROS T)) ;FIRST, SOME USEFUL MACROS.
␈↓ αλ(DECLARE (SETQ DISPLACE NIL) (SPECIAL DISPLACE)) % (DEFUN DISPLACE (X Y)
␈↓ α,(COND (DISPLACE (RPLACA X (CAR Y)) (RPLACD X (CDR Y))))
␈↓ α8Y) (SETQ DISPLACE T) % (DEFUN QEXPANDER (M)
␈↓ α\(PROG (X Y)
␈↓ β$(COND ((ATOM M) (RETURN (LIST 'QUOTE M)))
␈↓ βl((EQ (CAR M) '/,) (RETURN (CDR M)))
␈↓ βl((AND (NOT (ATOM (CAR M)))
␈↓ ∧4(EQ (CAAR M) '/@))
␈↓ βx(RETURN (LIST 'APPEND (CDAR M) (QEXPANDER (CDR M))))))
␈↓ β$(SETQ X (QEXPANDER (CAR M))
␈↓ βlY (QEXPANDER (CDR M)))
␈↓ β$(AND (NOT (ATOM X))
␈↓ β`(NOT (ATOM Y))
␈↓ β`(EQ (CAR X) 'QUOTE)
␈↓ β`(EQ (CAR Y) 'QUOTE)
␈↓ β`(EQ (CADR X) (CAR M))
␈↓ β`(EQ (CADR Y) (CDR M))
␈↓ β`(RETURN (LIST 'QUOTE M)))
␈↓ β$(RETURN (LIST 'CONS X Y)))) %(DEFUN QMAC () (QEXPANDER (READ)))
␈↓ αλ%(DEFUN CMAC () (CONS '/, (READ))) %(DEFUN AMAC () (CONS '/@ (READ))) (*ARRAY
␈↓ αλ'SCHEMEREAD 'READTABLE) ((LAMBDA (READTABLE)


␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εl14␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ αt%(SSTATUS MACRO /" 'QMAC)
␈↓ αt%(SSTATUS MACRO /, 'CMAC)
␈↓ αt%(SSTATUS MACRO /@ 'AMAC))
␈↓ α∀(GET 'SCHEMEREAD 'ARRAY)) (SETQ READTABLE (GET 'SCHEMEREAD 'ARRAY)) (DEFPROP
␈↓ αλDO ADO AMACRO) (DEFUN ADO (X)
␈↓ α,(DISPLACE X
␈↓ αP"(LABELS ((,DONAME
␈↓ β`(LAMBDA (,DOBODY @(MAPCAR 'CAR (CADR X)))
␈↓ ∧@(IF ,(CAADDR X) ,(BLOCKIFY (CDADDR X))
␈↓ ∧p(,DONAME ,(BLOCKIFY (CDDDR X))
␈↓ ¬\@(MAPCAR '(LAMBDA (Y)
␈↓ π4(COND ((AND (CDR Y) (CDDR Y))
␈↓ λλ(CADDR Y))
␈↓ π|(T (CAR Y))))
␈↓ εH(CADR X)))))))
␈↓ β(,DONAME NIL @(MAPCAR '(LAMBDA (Y) (AND (CDR Y) (CADR Y))) (CADR
␈↓ αλX)))))) (SETQ DONAME (MAKNAM (EXPLODEC '*DOLOOP*))) (SETQ DOBODY (MAKNAM
␈↓ αλ(EXPLODEC '*DOBODY*))) (DEFPROP COND ACOND AMACRO) (DEFUN ACOND (X)
␈↓ α\(COND ((NULL (CDR X)) (ERROR '|PECULIAR COND| X 'FAIL-ACT))
␈↓ β$(T (DISPLACE X (ACOND1 (CDR X)))))) (DEFUN ACOND1 (X)
␈↓ αP(COND ((NULL X) NIL)
␈↓ β_((EQ (CAAR X) 'T) (BLOCKIFY (CDAR X)))
␈↓ β_(T "(IF ,(CAAR X) ,(BLOCKIFY (CDAR X))
␈↓ βx,(ACOND1 (CDR X)))))) (DEFPROP BLOCK ABLOCK AMACRO) (DEFUN
␈↓ αλABLOCK (X)
␈↓ α\(COND ((OR (NULL (CDR X))
␈↓ β`(NULL (CDDR X)))
␈↓ β0(ERROR '|PECULIAR BLOCK| X 'FAIL-ACT))
␈↓ β$(T (DISPLACE X
␈↓ βx"((LAMBDA (@(MAPCAR '(LAMBDA (X) '**A**) (CDDR X)) **B**)
␈↓ αλ(**B**))
␈↓ ∧⊂@(NREVERSE (CDR (REVERSE (CDR X)))) (LAMBDA () ,(CAR (LAST
␈↓ αλX)))))))) (DEFUN BLOCKIFY (X)
␈↓ α\(COND ((NULL X) NIL)
␈↓ β$((NULL (CDR X)) (CAR X))
␈↓ β$(T "(BLOCK @X)))) (DEFPROP AND AAND AMACRO) (DEFUN AAND (X)
␈↓ α\(DISPLACE X (COND ((OR (NULL (CDR X))
␈↓ ∧p(NULL (CDDR X)))
␈↓ ∧@(ERROR '|PECULIAR AND| X 'WRNG-NO-ARGS))
␈↓ ∧4(T (AAND1 (CDR X)))))) (DEFUN AAND1 (X)
␈↓ α\(COND ((NULL (CDR X)) (CAR X))
␈↓ β$(T "((LAMBDA (**A** **F**)
␈↓ ∧@(IF **A** (**F**) NIL))
␈↓ β`,(CAR X)
␈↓ β`(LAMBDA () ,(AAND1 (CDR X))))))) (DEFPROP OR AOR AMACRO) (DEFUN
␈↓ αλAOR (X)
␈↓ α\(DISPLACE X (COND ((OR (NULL (CDR X))
␈↓ ∧p(NULL (CDDR X)))
␈↓ ∧@(ERROR '|PECULIAR OR| X 'WRNG-NO-ARGS))
␈↓ ∧4(T (AOR1 (CDR X)))))) (DEFUN AOR1 (X)


␈↓ αλ␈↓&␈↓↓Sussman and Steele    January 6, 1976␈↓ εl15␈↓ 	xSCHEME FLASH #1␈↓'β␈↓'α␈↓








␈↓ α\(COND ((NULL (CDR X)) (CAR X))
␈↓ β$(T "((LAMBDA (**A** **F**)
␈↓ ∧@(IF **A** **A** (**F**)))
␈↓ β`,(CAR X)
␈↓ β`(LAMBDA () ,(AOR1 (CDR X))))))) (DEFUN ORIFY (X)
␈↓ α\(COND ((NULL X) NIL)
␈↓ β$((NULL (CDR X)) (CAR X))
␈↓ β$(T (CONS 'OR X)))) (DEFPROP AMAPCAR AMAPCAR1 AMACRO) (DEFUN AMAPCAR1
␈↓ αλ(X)
␈↓ α\(COND ((NULL (CDDR X))
␈↓ β0(ERROR '|PECULIAR AMAPCAR| X 'WRNG-NO-ARGS))
␈↓ β$(T ((LAMBDA (NAMES)
␈↓ ∧∧(DISPLACE X
␈↓ ∧4"(DO ((,(CAR NAMES)
␈↓ ¬λNIL
␈↓ ¬λ(CONS (,(CADR X) @(MAPCAR '(LAMBDA (Y) "(CAR ,Y))
␈↓ πL(CDR NAMES)))
␈↓ ¬P,(CAR NAMES)))
␈↓ ∧|@(MAPCAR '(LAMBDA (Y N) "(,N ,Y (CDR ,N)))
␈↓ ¬t(CDDR X)
␈↓ ¬t(CDR NAMES)))
␈↓ ∧p(,(ORIFY (MAPCAR '(LAMBDA (N) "(NULL ,N)) (CDR NAMES)))
␈↓ ∧|(NREVERSE ,(CAR NAMES))))))
␈↓ βT(DO ((Z (CDR X) (CDR Z))
␈↓ ∧⊂(N NIL (CONS (GENSYM) N)))
␈↓ ∧∧((NULL Z) N)))))) (DEFPROP AMAPLIST AMAPLIST1 AMACRO) (DEFUN
␈↓ αλAMAPLIST1 (X)
␈↓ α\(COND ((NULL (CDDR X))
␈↓ β0(ERROR '|PECULIAR AMAPLIST| X 'WRNG-NO-ARGS))
␈↓ β$(T ((LAMBDA (NAMES)
␈↓ ∧∧(DISPLACE X
␈↓ ∧4"(DO ((,(CAR NAMES)
␈↓ ¬λNIL
␈↓ ¬λ(CONS (,(CADR X) @(CDR NAMES)) ,(CAR NAMES)))
␈↓ ∧|@(MAPCAR '(LAMBDA (Y N) "(,N ,Y (CDR ,N)))
␈↓ ¬t(CDDR X)
␈↓ ¬t(CDR NAMES)))
␈↓ ∧p(,(ORIFY (MAPCAR '(LAMBDA (N) "(NULL ,N)) (CDR NAMES)))
␈↓ ∧|(NREVERSE ,(CAR NAMES))))))
␈↓ βT(DO ((Z (CDR X) (CDR Z))
␈↓ ∧⊂(N NIL (CONS (GENSYM) N)))
␈↓ ∧∧((NULL Z) N)))))) (DEFPROP UREAD AFSUBR AMACRO) (DEFPROP
␈↓ αλGRINDEF AFSUBR AMACRO) (DEFPROP FASLOAD AFSUBR AMACRO) (DEFPROP EDIT AFSUBR
␈↓ αλAMACRO) (DEFPROP STATUS AFSUBR AMACRO) (DEFPROP SSTATUS AFSUBR AMACRO)
␈↓ αλ(DEFPROP SETQ AFSUBR AMACRO) (DEFPROP DEFUN AFSUBR AMACRO) (DEFUN AFSUBR (X)
␈↓ αλ"(EVAL ',X))